Language/OS - Multiplatform Resource Library/LANGUAGE OS.iso/quintus/quintus0.lha/work/library_2.06.2

Text File | 1992-04-03 | 23KB | 905 lines

%%% LIBRARY SECTION
%%% version 2.00.0 (based on library_16.3)
%%%   added identical_delete_all
%%%   added identical_delete_all_duplicates
%%% version 2.00.1
%%%   added var_eq_member
%%%   added var_eq
%%% version 2.00.5
%%%   added list_vars
%%% version 2.00.9
%%%   added count_occurrences
%%%   fixed bug in var_eq
%%%   moved ground from rewrite to library
%%%   moved unground from rewrite to library
%%%   added increment_counter
%%%   added set_counter
%%%   optimized var_eq
%%% version 2.01.9
%%%   optimized term rewriting
%%% version 2.04.0
%%%   logically erased nuclei while hyper-linking
%%% version 2.04.3
%%%   added reverse/2
%%% version 2.04.6
%%%   added min_list
%%%   added get_list
%%% version 2.04.8
%%%   added get_subterms
%%% version 2.05.1
%%%   added gensym
%%%   added common_variables
%%% version 2.05.3
%%%   moved numbervars to als
%%%   replaced integer_name with name
%%% version 2.05.8
%%%   removed append/3
%%% version 2.06.0
%%%   added is_subterm/2
%%%   added identical_subset/2
%%%   added identical_set_difference/3
%%%   added substitute_term/4
%%%   added identical_embedded/2
%%%   added identical_set/2
%%%   made delete_all/3 and identical_delete_all/3 deterministic
%%%   added replace_list/4
%%%   or_list/2
%%% version 2.06.1
%%%   added substitute_term_all/4
%%%   added permutations/2
%%%   added append_lists/2
%%%   added tail/2
%%%   added retract_all/1
%%% version 2.06.2
%%%   added ground_like/4
%%%   added term_size_structure/2
%%%   added enumerate/4

%%%
%%% LINEARIZATION
%%%
%%% linearize_term creates a linearized version of a term i.e.
%%% linearize_term(p(X,X),p(X,V),[X],[V])
%%% call at top level by linearize_term(Term,X,Y,Z).
%%% To make possible fast unification
%%% using Prolog's built in unification without occurs check.

     linearize_term(Term, Term, [], []) :-
    numbervars(Term,0,0), !.
     linearize_term(Term, Newterm, Vars1, Vars2) :-
    linearize(Term, Newterm, [], [], Oldvars, Newvars),
    pairs(Oldvars, Newvars, Vars1, Vars2, Vars3), !.

%%% Makes use of predicate linearize, with arguments as follows:
%%% linearize(Input_term, Linearized_version, Previous_oldvars,
%%%    Previous_linearized_vars, New_oldvars, New_linearized_vars)
%%% so linearize(p(X,X),p(U,V),[],[],[X,X],[U,V])
%%% call at top level by linearize(Input_term, Y, [], [], U, V).
%%% generate a new variable S after the first time a
%%% variable is seen.
     linearize(R,S,O1,O2,[R|O1],[S|O2]) :-
    var(R), identical_member(R,O1), !.
%%% don't generate a new variable S.
     linearize(R,R,O1,O2,[R|O1],[R|O2]) :- var(R), !.
     linearize(R,S,Old1,Old2,New1,New2) :-
    R =.. [F|Rlist],
    linearize2(Rlist,Slist,Old1,Old2,New1,New2),
    S =.. [F|Slist].

     linearize2([],[],Old1,Old2,Old1,Old2) :- !.
     linearize2([R|Rlist],[S|Slist],Old1,Old2,New1,New2) :-
    linearize(R,S,Old1,Old2,Mid1,Mid2),!,
    linearize2(Rlist,Slist,Mid1,Mid2,New1,New2).

%%% pairs takes two lists and finds matching variables.  For
%%% example, pairs([X,X,Y],[X1,X2,X3],[X1],[X2],[X]).  This
%%% makes use of the lists returned by linearize.
     pairs([X|L1],[Y|L2],[Y|Z1],[W|Z2],V) :-
    identical_member(X,L1), !,
    firstmatch(X,L1,L2,W),
    pairs(L1,L2,Z1,Z2,Z3),
    remove_duplicates([X|Z3],V).

     pairs([X|L1],[Y|L2],Z1,Z2,Z3) :-
    pairs(L1,L2,Z1,Z2,Z3).
     pairs([],[],[],[],[]).

     firstmatch(X,[Y|L1],[Z|L2],Z) :-
    X==Y,!.
     firstmatch(X,[Y|L1],[Z|L2],W) :-
    firstmatch(X,L1,L2,W).

%%% rename a variable if an identical one exists.
     remove_duplicates([X|Y],[U|Y]) :-
    identical_member(X,Y), !.
     remove_duplicates(X,X).

%%% unify two lists.
     unify_lists([], []) :- !.
     unify_lists([X|XRest], [Y|YRest]) :-
    unify(X, Y), !,
    unify_lists(XRest, YRest).

%%% Occurs check.
     occurs_check(Term, Var) :-
    var(Term), !, Term \== Var.
     occurs_check(Term, Var) :-
    functor(Term, _, Arity),
    occurs_check(Arity, Term, Var).

     occurs_check(0, _, _) :- !.
     occurs_check(N, Term, Var) :-
    arg(N, Term, Arg),
    occurs_check(Arg, Var),
    M is N-1, !,
    occurs_check(M, Term, Var).

%%% unify with occurs check.
     unify(X,Y) :- X == Y, !.
     unify(X,Y) :- unify1(X,Y), !.

     unify1(X, Y) :-
    var(X), var(Y), !, X = Y.
     unify1(X, Y) :-
    var(X), !, occurs_check(Y, X), X = Y.
     unify1(X, Y) :-
    var(Y), !, occurs_check(X, Y), Y = X.
     unify1(X, Y) :-
    atomic(X), !, X = Y.
     unify1(X, Y) :-
    functor(X, F, N), functor(Y, F, N),
    unify1(N, X, Y).

     unify1(0, X, Y) :- !.
     unify1(N, X, Y) :-
    arg(N, X, Xn), arg(N, Y, Yn),
    unify(Xn, Yn),
    M is N-1, !,
    unify1(M, X, Y).


%%% separate Nth element and the rest from a list.
     retrieve_N(L,NN,X,Rest) :-
    retrieve_N(L,1,NN,X,Rest), !.
     retrieve_N([L|Ls],N1,N2,X,[L|Rs]) :-
    N1 < N2,
    NN is N1 + 1,
    !,
    retrieve_N(Ls,NN,N2,X,Rs).
     retrieve_N([L|Ls],N,N,L,Ls).

%%% separate Nth element and the rest from two lists.
     retrieve_N2(L1,L2,NN,X,Xs,Y,Ys) :-
    retrieve_N2(L1,L2,1,NN,X,Xs,Y,Ys), !.
     retrieve_N2([L1|Ls1],[L2|Ls2],N1,N2,X,[L1|Xs],Y,[L2|Ys]) :-
    N1 < N2,
    NN is N1 + 1,
    !,
    retrieve_N2(Ls1,Ls2,NN,N2,X,Xs,Y,Ys).
     retrieve_N2([L1|Ls1],[L2|Ls2],N,N,L1,Ls1,L2,Ls2).

%%% find a member.
     member(X,[X|_]).
     member(X,[_|Ys]) :- member(X,Ys).

%%% find an identical member.
     identical_member(X,[Y|Z]) :- X == Y,!.
     identical_member(X,[Y|Z]) :- identical_member(X,Z).

%%% find a member and the rest.
     member_N([X|Xs],X,Xs).
     member_N([X|Xs],Y,[X|Zs]) :-
    member_N(Xs,Y,Zs).

%%% reverse a list.
     reverse(X,Y) :- reverse(X,[],Y).
     reverse([],X,X) :- !.
     reverse([X|Xs],Y,Z) :- reverse(Xs,[X|Y],Z).

%%% delete all the occurrences in a list.
     delete_all(_,[],[]) :- !.
     delete_all(X,[X|Ys],Z) :-
    !,
    delete_all(X,Ys,Z).
     delete_all(X,[Y|Ys],[Y|Z]) :-
    delete_all(X,Ys,Z).

%%% delete all the identical occurrences in a list.
     identical_delete_all(_,[],[]) :- !.
     identical_delete_all(X,[Y|Ys],Z) :-
    X==Y,
    !,
    identical_delete_all(X,Ys,Z).
     identical_delete_all(X,[Y|Ys],[Y|Z]) :-
    identical_delete_all(X,Ys,Z).

%%% merge with duplicate deletion.
     merge([X|Xs],Y,Z) :-
    member(X,Y),
    !,
    merge(Xs,Y,Z).
     merge([X|Xs],Y,[X|Zs]) :-
    !,
    merge(Xs,Y,Zs).
     merge([],Z,Z).

%%% merge of two ordered lists with duplicate deletion.
     ordered_merge([X|XR],[X|YR],[X|Z]) :-
    !,
    ordered_merge(XR,YR,Z).
     ordered_merge([X|XR],[Y|YR],[X|Z]) :-
    X < Y,
    !,
    ordered_merge(XR,[Y|YR],Z).
     ordered_merge([X|XR],[Y|YR],[Y|Z]) :-
    !,
    ordered_merge([X|XR],YR,Z).
     ordered_merge([],Y,Y) :- !.
     ordered_merge(X,[],X).

%%% get the minumum of two values.
     minimum(X,Y,Y) :- Y =< X, !.    % red cut.
     minimum(X,Y,X).

%%% get the maximum of two values.
     maximum(X,Y,Y) :- Y >= X, !.    % red cut.
     maximum(X,Y,X).

%%% calculate the size of a term.
%%% constants: counted as 1.
%%% varaibles: counted as 1.
%%% functiors: counted as 1 plus the size of all its arguments.
%%% predicates: counted as 1 plus the size of all its arguments.
     term_size(Term,Size) :-
    term_size(Term,0,Size), !.
     term_size(Term,Size1,Size2) :-
    atomic(Term), !, Size2 is Size1 + 1.
     term_size(Term,Size1,Size2) :-
    var(Term), !, Size2 is Size1 + 1.
     term_size(Term,Size1,Size2) :-
    functor(Term,F,N),
    SizeM is Size1 + 1,
    args_size(Term,0,N,SizeM,Size2).

     args_size(Term,N1,N2,SizeI,SizeO) :-
    NN is N1 + 1,
    NN =< N2,
    arg(NN,Term,Arg),
    term_size(Arg,SizeI,SizeM),
    !,
    args_size(Term,NN,N2,SizeM,SizeO).
     args_size(Term,N,N,SizeO,SizeO).

%%% term_depth is to calculate the number of nesting levels of a term.
%%% constants: counted as 0.
%%% variables: counted as 0.
%%% functors: counted as 1 plus the maximum depth of its arguments.
%%% predicates: counted as 1 plus the maximum depth of its arguments.
     term_depth(X,0) :- var(X), !.
     term_depth(X,0) :- atomic(X), !.
     term_depth(X,D) :-
    X =.. [F|Args],
    arg_depth(Args,0,Darg),
    D is Darg + 1, !.
     arg_depth([A1|As],Din,Dout) :-
    term_depth(A1,D1),
    maximum(Din,D1,D2), !,
    arg_depth(As,D2,Dout).
     arg_depth([],D,D).


%%% Find the biggest number in a list.
%%% max_list fails if the list is empty.
     max_list([P|Ps],M) :- max_list(Ps,P,M), !.
     max_list([P2|Ps],P1,M) :-
    P2 > P1, !,
    max_list(Ps,P2,M).
     max_list([_|Ps],P1,M) :-
    !, max_list(Ps,P1,M).
     max_list([],M,M).

%%% Find the smallest number in a list.
%%% min_list fails if the list is empty.
     min_list([P|Ps],M) :- min_list(Ps,P,M), !.
     min_list([P2|Ps],P1,M) :-
    P2 < P1, !,
    min_list(Ps,P2,M).
     min_list([_|Ps],P1,M) :-
    !, min_list(Ps,P1,M).
     min_list([],M,M).

%%% Compute distinct variable list of a term with a left-over dummy variable.
%%%     The left-over dummy variable is used to unify with unequally long
%%%    conatant list.
%%% For example, the list for g(X,f(a,Y)) is [X,Y|Z].

     vars_tail(Term,Vars) :-
    vars_tail(Term,[],_,Vars,Hole), !.

     vars_tail(Term, Sofar_in, Sofar_in,Hole,Hole) :- atomic(Term), !.
     vars_tail(Term, Sofar_in, Sofar_in,Hole,Hole) :- var(Term),
         identical_member(Term, Sofar_in), !.
     vars_tail(Term, Sofar_in, [Term|Sofar_in],[Term|Hole],Hole) :-
      var(Term), !.
     vars_tail(Term, Sofar_in,Sofar_out,Vars,Hole) :-
    functor(Term, _, N),
    vars_tail(0,N,Term,Sofar_in,Sofar_out,Vars,Hole).

     vars_tail(N,N,_,S,S,Hole,Hole) :- !.
     vars_tail(N1,N2,Term,Sofar_in,Sofar_out,Vars,Hole) :-
    M is N1+1,
    arg(M,Term,Arg),
    vars_tail(Arg,Sofar_in,Sofar_mid,Vars,Hole1),
    !,
    vars_tail(M,N2,Term,Sofar_mid,Sofar_out,Hole1,Hole).


%%% copy a term without using assert and retract.
     new_copy(R,S) :- new_copy(R,S,[],O).

     new_copy(R,R,O1,O1) :-
    atomic(R), !.
     new_copy(R,S,O1,O1) :-
    var(R), memcopy(R,O1,S), !.
     new_copy(R,S,O1,[vp(R,S)|O1]) :-
    var(R), !.
     new_copy(R,S,O1,O2) :-
    R =.. [F|Rlist],
    new_copy2(Rlist,Slist,O1,O2),
    S =.. [F|Slist].

     new_copy2([],[],O1,O1) :- !.
     new_copy2([R|Rlist],[S|Slist],O1,O2) :-
    new_copy(R,S,O1,M1), !,
    new_copy2(Rlist,Slist,M1,O2).

     memcopy(R,[vp(S,T)|_],T) :- R == S, !.
     memcopy(R,[_|Ys],T) :- memcopy(R,Ys,T).


%%% remove ``not'' if there, add if not.
     negate(not(X),X) :- !.
     negate(X,not(X)).

%%% return [] if bagof fails.
     bagof1(X,G,C) :-
    bagof(X,G,C), !.
     bagof1(_,_,[]).

%%% check if a term is a list.
     is_list([_|_]) :- !.
     is_list([]).

%%% remove all duplicates in a list.
     delete_all_duplicates([X|Xs],[X|Ys]) :-
    delete_all(X,Xs,Z),
    !,
    delete_all_duplicates(Z,Ys).
     delete_all_duplicates([],[]).

%%% remove all identical duplicates in a list.
     identical_delete_all_duplicates([X|Xs],[X|Ys]) :-
    identical_delete_all(X,Xs,Z),
    !,
    identical_delete_all_duplicates(Z,Ys).
     identical_delete_all_duplicates([],[]).

%%% Make an ordinal list for a list. If a list has N members, then the
%%% ordinal list is [1,...,N].
     corresp_ordinals_list(List,OrdList) :-
    corresp_ordinals_list(List,1,OrdList), !.
     corresp_ordinals_list([_|Ls],N1,[N1|Os]) :-
    N2 is N1 + 1, !,
    corresp_ordinals_list(Ls,N2,Os).
     corresp_ordinals_list([],_,[]).

%%% The list contains of |C| L2's, and one L1's at Nth position.
     list_one_N(C,L2,N,L1,List) :-
    list_one_N(C,L2,1,N,L1,List), !.
     list_one_N([_|Lits],L2,N2,N2,L1,[L1|List]) :-
    NN is N2 + 1,
    !, list_one_N(Lits,L2,NN,N2,L1,List).
     list_one_N([_|Lits],L2,N1,N2,L1,[L2|List]) :-
    NN is N1 + 1,
    !, list_one_N(Lits,L2,NN,N2,L1,List).
     list_one_N([],_,_,_,_,[]).

%%% The output contains of |C| binary numbers, and the content in positions
%%%    specified by the list L are N2, the others are N1.
     list_multi_Ns(C,N1,L,N2,List) :-
    list_multi_Ns(C,N1,1,L,N2,List), !.
     list_multi_Ns([_|Lits],N1,N,[N|L],N2,[N2|List]) :-
    NN is N + 1,
    !, list_multi_Ns(Lits,N1,NN,L,N2,List).
     list_multi_Ns([_|Lits],N1,N,L,N2,[N1|List]) :-
    NN is N + 1,
    !, list_multi_Ns(Lits,N1,NN,L,N2,List).
     list_multi_Ns([],_,_,_,_,[]).

%%% The list contains of |C| L2's.
     list_of_Ns([_|Lits],L2,[L2|List]) :-
    !, list_of_Ns(Lits,L2,List).
     list_of_Ns([],_,[]).

%%% A list of natural numbers from 1 to N.
     list_of_natural_numbers_up_to_N(N,Un) :-
    list_of_natural_numbers_up_to_N(1,N,Un), !.
     list_of_natural_numbers_up_to_N(N1,N2,[N1|Un]) :-
    N1 < N2,
    NN is N1 + 1, !,
    list_of_natural_numbers_up_to_N(NN,N2,Un).
     list_of_natural_numbers_up_to_N(N1,N1,[N1]) :- !.
     list_of_natural_numbers_up_to_N(_,_,[]).

%%% Succeeds if the input ground clause is a tautology.
     tautology_clause(C) :-
    append(_,[X|T],C),
    negate(X,Y),
    member(Y,T), !.

%%% Succeeds if the input first-order clause is a tautology.
     fol_tautology_clause(C) :-
    append(_,[X|T],C),
    negate(X,Y),
    identical_member(Y,T), !.

%%% return 1 if unit, otherwise 0.
     decide_unit([_],1) :- !.
     decide_unit(_,0) :- !.

%%% Assert X once.
     assert_once(X) :-
         X, !.
     assert_once(X) :-
      assert(X), !.

%%% Negate all literals in a clause.
     negate_clause([D1|Ds1],[D2|Ds2]) :-
    negate(D1,D2),
    !, negate_clause(Ds1,Ds2).
     negate_clause([],[]).

%%% List_vars generates a list of variables in a term.
     list_vars(T,Vs) :-
    list_vars_1(T,[],Vs1),
        identical_delete_all_duplicates(Vs1,Vs),
    !.
     list_vars_1(T,Vs,[T|Vs]) :-
    var(T),
    !.
     list_vars_1(T,Vs1,Vs2) :-
    functor(T,_,N),
    list_vars_2(T,Vs1,Vs2,N).
     list_vars_2(_,Vs,Vs,0).
     list_vars_2(T,Vs1,Vs2,N) :-
    arg(N,T,A),
    list_vars_1(A,Vs1,Vs3),
    N1 is N-1,
    !,
    list_vars_2(T,Vs3,Vs2,N1).

%%% Count_occurrences counts the number of times one term occurs in another.
     count_occurrences(T1,T2,N) :- count_occurrences_1(T1,T2,0,N).
     count_occurrences_1(T1,T2,N1,N2) :-
    T1==T2,
    !,
    N2 is N1+1.
     count_occurrences_1(T1,T2,N1,N2) :-
    nonvar(T2),
    !,
    functor(T2,_,A),
    count_occurrences_2(T1,T2,N1,N2,A).
     count_occurrences_1(_,_,N,N).
     count_occurrences_2(_,_,N,N,0).
     count_occurrences_2(T1,T2,N1,N2,A) :-
    arg(A,T2,T3),
    count_occurrences_1(T1,T3,N1,N3),
    A1 is A-1,
    !,
    count_occurrences_2(T1,T2,N3,N2,A1).

%%% Ground grounds a term.  Ground also returns a list of the variables in the
%%% term and a list of the constants used to ground the term.
     ground(T1,T2,Vs,Cs) :-
    vars_tail(T1,Vs),
        const_list(Cs),
    not(not(ground1(T1,Vs))),
    retract(grnd(T2)),
    !.
     ground1(T,Vs) :-
    const_list(Vs),
    asserta(grnd(T)),
    !.

%%% Ground_like grounds a term using a specified list of variables and
%%% constants.
     ground_like(T1,T2,Vs,Cs) :-
    not(not(ground_like1(T1,Vs,Cs))),
    retract(grnd_like(T2)),
    !.
     ground_like1(T,Vs,Vs) :-
    asserta(grnd_like(T)),
    !.

%%% Unground ungrounds a grounded term.
     unground(T,T,Vs,_) :-
    var(Vs),
    !.
     unground(T1,T2,Vs,Cs) :-
    atom(T1),
    !,
    unground1(T1,T2,Vs,Cs).
     unground(T1,T2,Vs,Cs) :-
    functor(T1,F,N),
    unground2(T1,As,Vs,Cs,N,1),
    T2=..[F|As].
     unground1(T,T,Vs,_) :-
    var(Vs),
    !.
     unground1(C,V,[V|_],[C|_]) :- !.
     unground1(T1,T2,[_|Vs],[_|Cs]) :-
    !,
    unground1(T1,T2,Vs,Cs).
     unground2(_,[],_,_,N,M) :-
    M>N,
    !.
     unground2(T,[A|As],Vs,Cs,N,M) :-
    arg(M,T,A1),
    unground(A1,A,Vs,Cs),
    M1 is M+1,
    !,
    unground2(T,As,Vs,Cs,N,M1).

%%% Increment increments a counter.
     increment_counter(C,N) :-
    retract(counter(C,N1)),
    N2 is N1+N,
    assert(counter(C,N2)),
    !.

%%% Set_counter sets a counter.
     set_counter(C,N) :-
    retract(counter(C,_)),
    !,
    assert(counter(C,N)),
    !.
     set_counter(C,N) :-
    assert(counter(C,N)),
    !.

%%% Logically erase a clause.
     logically_erase(Proc,Ref) :-
    assertz(logically_erased(Proc,Ref)).

%%% Physically erase the logically erased clauses of a procedure.
     physically_erase(Proc) :-
    retract(logically_erased(Proc,Ref)),
    erase(Ref),
    fail.
     physically_erase(_).

%%% Obtain the Nth element of a list.
     get_list(Xs,N,X) :- get_list(Xs,N,X,1).
     get_list([X|_],N,X,N) :- !.
     get_list([_|Xs],N,X,N1) :-
    N2 is N1 + 1,
    !,
    get_list(Xs,N,X,N2).

%%% Get all distinct subterms of a term.
     get_subterms(T,Ss) :-
    get_subterms_1(T,Ss1),
    identical_delete_all_duplicates(Ss1,Ss),
    !.
     get_subterms_1(T,[T]) :-
    var(T),
    !.
     get_subterms_1(T,[T|Ss]) :-
    functor(T,_,N),
    get_subterms_2(T,N,Ss),
    !.
     get_subterms_2(_,0,[]).
     get_subterms_2(T,N,Ss) :-
    arg(N,T,T1),
    get_subterms_1(T1,Ss1),
    N1 is N-1,
    get_subterms_2(T,N1,Ss2),
    append(Ss2,Ss1,Ss),
    !.

%%% Gensym -- from Clocksin and Mellish
     gensym(Root,Atom) :-
    get_num(Root,Num),
    name(Root,Name1),
    name(Num,Name2),
    append(Name1,Name2,Name),
    name(Atom,Name).
     get_num(Root,Num) :-
    retract(current_num(Root,Num1)),
    !,
    Num is Num1+1,
    asserta(current_num(Root,Num)).
     get_num(Root,1) :-
    asserta(current_num(Root,1)).

%%% Common_variables determines the variables common to two terms.
     common_variables(T1,T2,Vs) :-
    list_vars(T1,Vs1),
    list_vars(T2,Vs2),
    common_variables_1(Vs1,Vs2,Vs).
     common_variables_1([],_,[]).
     common_variables_1([V|Vs1],Vs2,[V|Vs3]) :-
    identical_member(V,Vs2),
    !,
    common_variables_1(Vs1,Vs2,Vs3).
     common_variables_1([_|Vs1],Vs2,Vs3) :-
    !,
    common_variables_1(Vs1,Vs2,Vs3).

%%% Determine if one term S is a subterm of another term T.
     is_subterm(S,T) :-
    S==T,
    !.
     is_subterm(S,T) :-
        nonvar(T),
    !,
    functor(T,_,N),
    is_subterm_1(S,T,N).
     is_subterm_1(_,_,0) :-
    !,
    fail.
     is_subterm_1(S,T,N) :-
    arg(N,T,T1),
    is_subterm(S,T1),
        !.
     is_subterm_1(S,T,N) :-
        N1 is N-1,
    !,
    is_subterm_1(S,T,N1).

%%% Determine if the first set is a subset of the second set.
     identical_subset([],_).
     identical_subset([A|X],Y) :-
    identical_member(A,Y),
        identical_subset(X,Y).

%%% Compute set difference.
     identical_set_difference([],_,[]).
     identical_set_difference([A|X],Y,Z) :-
    identical_member(A,Y),
    !,
    identical_set_difference(X,Y,Z).
     identical_set_difference([A|X],Y,[A|Z]) :-
    identical_set_difference(X,Y,Z).

%%% substitute_term(T,U,V,Ts) :-
%%%   input
%%%     T  : term
%%%     U  : term
%%%     V  : term not identical to U
%%%   output
%%%     Ts : list of terms T' such T' is T with a single occurrence of U
%%%          replaced by V.  Note that the length of Ts is equal to the number
%%%          of occurrences of U in T.
     substitute_term(T,U,V,Ts) :-
    bagof1(T1,substitute_term_1(T,U,V,T1),Ts).
     substitute_term_1(T1,U,V,T2) :-
    substitute_term_2(T1,U,V,T2),
    T1\==T2.
     substitute_term_2(T,U,V,V) :-
    T==U.
     substitute_term_2(T,_,_,T) :-
    var(T).
     substitute_term_2(T1,U,V,T2) :-
    nonvar(T1),
    T1=..[F|Ts1],
    substitute_term_3(Ts1,U,V,Ts2),
    T2=..[F|Ts2].
     substitute_term_3([],_,_,[]).
     substitute_term_3([T1|Ts1],U,V,[T2|Ts2]) :-
    substitute_term_2(T1,U,V,T2),
        substitute_term_4(T1,T2,Ts1,U,V,Ts2).
     substitute_term_4(T1,T2,Ts,_,_,Ts) :-
    T1\==T2.
     substitute_term_4(T1,T2,Ts1,U,V,Ts2) :-
    T1==T2,
    substitute_term_3(Ts1,U,V,Ts2).

%%% substitute_term_all(T1,U,V,T2) :-
%%%   input
%%%     T1 : term
%%%     U  : term
%%%     V  : term not identical to U
%%%   output
%%%     T2 : T with a all occurrences of U replaced by V.
     substitute_term_all(T,U,V,V) :-
    T==U,
    !.
     substitute_term_all(T,_,_,T) :-
    var(T),
        !.
     substitute_term_all(T1,U,V,T2) :-
    T1=..[F|Ts1],
    substitute_term_all_1(Ts1,U,V,Ts2),
    T2=..[F|Ts2].
     substitute_term_all_1([],_,_,[]).
     substitute_term_all_1([T1|Ts1],U,V,[T2|Ts2]) :-
    substitute_term_all(T1,U,V,T2),
        substitute_term_all_1(Ts1,U,V,Ts2).

%%% identical_embedded(U,V)
%%%   input
%%%     U : term
%%%     V : term
%%%   exception
%%%     fails if U not embedded in V
     identical_embedded(U,V) :-
    U==V,
    !.
     identical_embedded(U,V) :-
        var(V),
    !,
    fail.
     identical_embedded(U,V) :-
    nonvar(U),
    functor(U,F,N),
    functor(V,F,N),
    U=..[_|Us],
    V=..[_|Vs],
    identical_embedded_1(Us,Vs).
     identical_embedded(U,V) :-
    V=..[_|Vs],
    identical_embedded_2(U,Vs).
     identical_embedded_1([],[]) :- !.
     identical_embedded_1([U|Us],[V|Vs]) :-
    identical_embedded(U,V),
    identical_embedded_1(Us,Vs).
     identical_embedded_2(U,[V|_]) :-
    identical_embedded(U,V),
    !.
     identical_embedded_2(U,[_|Vs]) :-
    identical_embedded_2(U,Vs).

%%% identical_set(S1,S2)
%%%   input
%%%     S1 : set
%%%     S2 : set
%%%   exceptions
%%%     fails if S1 does not equal S2
     identical_set(S1,S2) :-
    length(S1,N),
    length(S2,N),
        identical_subset(S1,S2).

%%% replace_list(L1,N,T,L2)
%%%   input
%%%     L1 : list
%%%     N  : integer
%%%     T  : term
%%%   output
%%%     L2 : L1 with Nth element replaced with T
%%%   exceptions
%%%     fails if N<0 or N>|L|
     replace_list(L1,N,T,L2) :- replace_list_1(L1,N,T,L2,1).
     replace_list_1([_|L1],N,T,[T|L1],N) :- !.
     replace_list_1([T1|L1],N,T2,[T1|L2],N1) :-
    N2 is N1 + 1,
    replace_list_1(L1,N,T2,L2,N2).

%%%
%%% or_list(L,V)
%%%   input
%%%     L : list of 0s and 1s
%%%   output
%%%     V : or the elements of L where 0 is false and 1 is true
%%%
     or_list(L,1) :-
    member(1,L),
    !.
     or_list(_,0).

%%%
%%% permutations(L,P)
%%%   input
%%%     L : list
%%%   output
%%%     P : list of permutations of L
%%%
     permutations([],[[]]) :- !.
     permutations([X],[[X]]) :- !.
     permutations([X,Y],[[X,Y],[Y,X]]) :- !.
     permutations(L,P) :-
    bagof(Pi,permutations_1(L,Pi),Pis),
    append_lists(Pis,P).
     permutations_1(L,Pi) :-
    member_N(L,X,L1),
    permutations(L1,Pi1),
    permutations_2(Pi1,X,Pi).
     permutations_2([],_,[]) :- !.
     permutations_2([L|Pi1],X,[[X|L]|Pi2]) :-
       permutations_2(Pi1,X,Pi2).

%%%
%%% append_lists(Ls,L)
%%%   input
%%%     Ls : list of lists
%%%   output
%%%     L  : lists of Ls appended together
%%%
      append_lists([],[]) :- !.
      append_lists([L1|Ls],L2) :-
    append_lists(Ls,L3),
    append(L1,L3,L2).

%%%
%%% tail(L,X)
%%%   input
%%%     L : list
%%%   output
%%%     X : last element in L
%%%   exceptions
%%%     fails if L is empty
%%%
     tail([X],X) :- !.
     tail([_|L],X) :-
       tail(L,X).

%%%
%%% retract_all(X)
%%%   input
%%%     X : Prolog term
%%%
     retract_all(X) :-
       retract(X),
       fail.
     retract_all(_).

%%%
%%% term_size_structure(Term,Size_structure)
%%%   input
%%%     Term : Prolog term
%%%   output
%%%     Structure: term structured like Term containing subterm sizes.  For
%%%                example, term_size_structure(f(f(X,g(a)),a),Structure) sets
%%%                structure to ss(6,ss(4,ss(1),ss(2,ss(1))),ss(1)).
%%%
     term_size_structure(Term,ss(1)) :-
    var(Term),
        !.
     term_size_structure(Term,Size_structure) :-
    functor(Term,_,N),
    term_size_structure_1(N,Term,0,Size1,Size_structure_list),
    Size is Size1+1,
    Size_structure =.. [ss,Size|Size_structure_list].
     term_size_structure_1(0,_,Size,Size,[]) :- !.
     term_size_structure_1(N,Term,Size1,Size2,
      [Size_structure|Size_structure_list]) :-
    functor(Term,_,M),
    I is M-N+1,
    arg(I,Term,Arg),
    term_size_structure(Arg,Size_structure),
        arg(1,Size_structure,Size3),
    Size4 is Size1+Size3,
    N1 is N-1,
    term_size_structure_1(N1,Term,Size4,Size2,Size_structure_list).

%%%
%%% enumerate(M,N,S,I)
%%%   input
%%%     M : integer
%%%     N : integer
%%%     S : non-zero integer
%%%  output
%%%     I : integer
%%%  note:
%%%    returns integers M through N inclusive by S via backtraking
%%%
     enumerate(M,N,S,_) :-
       ((S>0, M>N);(S<0,M<N)),
       !,
       fail.
     enumerate(M,N,_,M).
     enumerate(M,N,S,I) :-
       M1 is M+S,
       enumerate(M1,N,S,I).